Function jd(jahr As Integer, monat As Integer, tag As Integer, stunde As Integer, _
 min As Integer, sec As Double, Zeitzone As Integer) As Double
 '  Umwandlung ins julianische Datum JD
    
    Dim a As Double
    Dim b As Integer
    
    If monat > 2 Then
    monat = monat
    jahr = jahr
    End If
    
    If monat <= 2 Then
    monat = monat + 12
    jahr = jahr - 1
    End If
    
    a = Fix(jahr / 100)
    b = 2 - a + Fix(a / 4)
    
    jd = Fix(365.25 * (jahr + 4716)) + Fix(30.6001 * (monat + 1)) + tag + b + ((stunde + min / 60 + sec / 3600) / 24) - 1524.5
    
    jd = jd - Zeitzone / 24
    
    
End Function
Private Function rang(x As Double) As Double
'
'  Winkelbereich: 0 ... 360

    Dim a As Double
    Dim b As Double
    b = x / 360
    a = 360 * (b - Fix(b))
    If (a < 0) Then
        a = a + 360
        End If
    rang = a
End Function


Function SternzeitLokal(jd As Double, Lnge As Double) As Double

'  lmst = lokale Sternzeit

'  west =  negative

    Dim lst As Double
    Dim t As Double
    Dim d As Double
    
  mjd = jd - 2400000.5
  d = mjd - 51544.5
  t = (d / 36525)
  lst = rang(280.46061837 + 360.98564736629 * d + 0.000387933 * t * t - t * t * t / 38710000)
  SternzeitLokal = (lst / 15) + (Lnge / 15)

  SternzeitLokal = SternzeitLokal * 15
  SternzeitLokal = rang(SternzeitLokal)

End Function

Function SternzeitGreenwich(jd As Double) As Double

'  gmst = Greenwich Sternzeit

'  West =  negativ   Ost = positiv

       
 Dim d As Double
    
  
  d = (jd - 2451545) / 36525
  
  gst = rang(280.46061837 + 360.98564736629 * (jd - 2451545) + 0.000387933 * d * d - d * d * d / 38710000)
  
   SternzeitGreenwich = (gst / 15)

   SternzeitGreenwich = SternzeitGreenwich * 15
   SternzeitGreenwich = rang(SternzeitGreenwich)
  
  

End Function
Function SternzeitGreenwichUT(jahr As Integer, monat As Integer, tag As Integer) As Double

'  gmst = Greenwich Sternzeit 0 Uhr UT

      
   Dim d As Double
 
   Dim a As Double
   Dim b As Double
   Dim jd As Double
    
    If monat > 2 Then
    monat = monat
    jahr = jahr
    End If
    
    If monat <= 2 Then
    monat = monat + 12
    jahr = jahr - 1
    End If
    
    a = Fix(jahr / 100)
    b = 2 - a + Fix(a / 4)
    
    jd = Fix(365.25 * (jahr + 4716)) + Fix(30.6001 * (monat + 1)) + tag + b - 1524.5
    
       
       
  d = (jd - 2451545) / 36525
  
  SternzeitGreenwichUT = rang(100.46061837 + 36000.770053608 * d + 0.000387933 * d * d - d * d * d / 38710000)
  
 SternzeitGreenwichUT = rang(SternzeitGreenwichUT)
 
 

End Function





 Function Winkelzeit(t As Double) As Date

'   Winkelbereich 0 ..360  nach Zeitformat hh:min:sec

    
    t = t / (15 * 24)
    Winkelzeit = t
    
End Function

Function Ekliptik(jd As Double) As Double

   Dim t As Double
    t = (jd - 2451545) / 36525
    t = 23.43929111 - (46.815 / 3600) * t - (0.00059 / 3600) * t * t + (0.001813 / 3600) * t * t * t
 Ekliptik = t
    
End Function



Function Stundenwinkel(gmst As Double, Lnge As Double, RA As Double) As Double

'Stdw = Stundenwinkel H
'Lnge  = positive Zhlung nach Osten

Stundenwinkel = rang(gmst - (360 - Lnge) - RA)
    
End Function

Function hhe(Stdw As Double, Breite As Double, dek As Double) As Double

Dim h As Double
h = sin(dek * 3.14159265358979 / 180) * sin(Breite * 3.14159265358979 / 180) + Cos(Breite * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180) * Cos(Stdw * 3.14159265358979 / 180)
hhe = Application.Asin(h) * 180 / 3.14159265358979
End Function
    
Function AzimutS(Stdw As Double, Breite As Double, dek As Double) As Double
'  Azimutzhlung mit Sd = 0


Dim a As Double
Dim b As Double
Dim c As Double
a = sin(Stdw * 3.14159265358979 / 180)
b = Cos(Stdw * 3.14159265358979 / 180) * sin(Breite * 3.14159265358979 / 180) - Tan(dek * 3.14159265358979 / 180) * Cos(Breite * 3.14159265358979 / 180)

c = Application.Atan2(b, a) * 180 / 3.14159265358979

If c < 0 Then c = c + 360 Else
AzimutS = c
End Function
Function AzimutN(Stdw As Double, Breite As Double, dek As Double) As Double
'  Azimutzhlung mit Nord = 0


Dim a As Double
Dim b As Double
Dim c As Double
a = sin(Stdw * 3.14159265358979 / 180)
b = Cos(Stdw * 3.14159265358979 / 180) * sin(Breite * 3.14159265358979 / 180) - Tan(dek * 3.14159265358979 / 180) * Cos(Breite * 3.14159265358979 / 180)

c = Application.Atan2(b, a) * 180 / 3.14159265358979 + 180

If c < 0 Then c = c + 360 Else

AzimutN = c

End Function

Function Refraktion(hhe As Double) As Double

'  Refraktion von  -1 bis 90


Dim r As Double
     
     
   
    r = 1 / (Tan((hhe + 7.31 / (hhe + 4.4)) * 3.14159265358979 / 180)) + 0.0013515
    r = r / 60
    
    If hhe < -1 Then r = 0
    
    Refraktion = hhe - r
   

    
End Function

Function RefraktionWahreHhe(hhe As Double) As Double

'  Refraktion von  -1 bis 90


Dim r As Double
     
     
   
    r = (1.02 / (Tan((hhe + 10.3 / (hhe + 5.11)) * 3.14159265358979 / 180)))
    
    r = (r / 60)
    
    If hhe < -1 Then r = 0
    
    RefraktionWahreHhe = hhe + r
   

    
End Function


Function RFWinkelpos(w As Double) As Double
'
'  Winkelbereich: 0 ... 360

    Dim a As Double
    Dim b As Double
    b = w / 360
    a = 360 * (b - Fix(b))
    If (a < 0) Then
        a = a + 360
        End If
    RFWinkelpos = a
End Function

Function RFWinkelneg(w As Double) As Double
'
'  Winkelbereich: 0 ... -360 bzw. 0 .... 360

    Dim a As Double
    Dim b As Double
    Dim c As Double
    
    a = w / 360
    b = Fix(w / 360)
    c = (a - b) * 360
         
    RFWinkelneg = c
    
End Function

Function Weltzeit(Ortszeit As Double, Zeitzone As Double) As Double
'
'  von Ortszeit nach Weltzeit UT

    Dim a As Double
    Dim b As Double
    
    a = Zeitzone / 24
    b = Ortszeit - a
    If b < 0 Then b = 1 + b
    Weltzeit = b
    
    
End Function

Function DatumWeltzeit(Ortszeit As Double, Ortsdatum As Double, Zeitzone As Double) As Double
'
'  von Ortsdatum nach Weltzeit-Datum UT

    Dim a As Double
    Dim b As Double
    
    a = Zeitzone / 24
    b = Ortszeit - a
    
    If b < 0 Then
    b = -1
    End If
    
    If b > 1 Then
    b = 1
    End If
    
    If Abs(b) <> 1 Then
    b = 0
    End If
    
    DatumWeltzeit = Ortsdatum + b
    
    
End Function

Function Ortszeit(Weltzeit As Double, Zeitzone As Double) As Double
'
'  von UT nach Ortszeit

    Dim a As Double
    Dim b As Double
    
    a = Zeitzone / 24
    b = Weltzeit + a
    If b < 0 Then b = 1 + b
    Ortszeit = b
    
    
End Function


Function Ortsdatum(Weltzeit As Double, Weltzeitdatum As Double, Zeitzone As Double) As Double
'
'  von Weltzeitdatum nach Datum UT

     Dim a As Double
    Dim b As Double
    
    a = Zeitzone / 24
    b = Weltzeit + a
    
    If b < 0 Then
    b = -1
    End If
    
    If b > 1 Then
    b = 1
    End If
    
    If Abs(b) <> 1 Then
    b = 0
    End If
    
    Ortsdatum = Weltzeitdatum + b
    
    
End Function

Function ExzentrischeAnomalie(m As Double, e As Double) As Double

'Lsung der Kepler-Gleichung

Dim a As Double


a = m + e * (180 / 3.14159265358979) * sin(m * 3.14159265358979 / 180) * (1 + e * Cos(m * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
 
a = a / 360
b = Fix(a)
c = a - b
d = 360 * c

If d < 0 Then
d = 360 + d
End If

ExzentrischeAnomalie = d


End Function



Function WahreAnomalie(m As Double, e As Double) As Double

Dim a As Double
Dim i As Double
Dim j As Double
Dim k As Double
Dim L As Double
Dim o As Double
Dim n As Double


a = m + e * (180 / 3.14159265358979) * sin(m * 3.14159265358979 / 180) * (1 + e * Cos(m * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
a = a + e * (180 / 3.14159265358979) * sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(a * 3.14159265358979 / 180))
a = a - (a - e * (180 / 3.14159265358979) * sin(a * 3.14159265358979 / 180) - m) / (1 - e * Cos(a * 3.14159265358979 / 180))
 
a = a / 360
b = Fix(a)
c = a - b
d = 360 * c

If d < 0 Then
d = 360 + d
End If


k = Sqr((1 + e) / (1 - e))
L = Tan((d / 2) * 3.14159265358979 / 180)
n = (L * k)


o = Application.Atan2(1, n) * 180 / 3.14159265358979
o = 2 * o
If o < 0 Then

o = 360 + o
End If


WahreAnomalie = o

End Function


Function NutationLnge(jd As Double) As Double

'  Nutation in Lnge

Dim t As Double
Dim L As Double
Dim ll As Double
Dim omega As Double
     
      
    t = (jd - 2451545) / 36525
    omega = 125.04452 - 1934.136261 * t + 0.0020708 * t * t + t * t * t / 450000
    L = 280.4665 + 36000.7698 * t
    ll = 218.3165 + 481267.8813 * t
    
   NutationLnge = -17.2 * sin(omega * 3.14159265358979 / 180) - 1.32 * sin(2 * L * 3.14159265358979 / 180) - 0.23 * sin(2 * ll * 3.14159265358979 / 180) + 0.21 * sin(2 * omega * 3.14159265358979 / 180)
  NutationLnge = NutationLnge / 3600
    
End Function


Function NutationBreite(jd As Double) As Double

'  Nutation in Lnge

Dim t As Double
Dim L As Double
Dim ll As Double
Dim omega As Double
     
       
    t = (jd - 2451545) / 36525
    omega = 125.04452 - 1934.136261 * t + 0.0020708 * t * t + t * t * t / 450000
    L = 280.4665 + 36000.7698 * t
    ll = 218.3165 + 481267.8813 * t
    
  NutationBreite = 9.2 * Cos(omega * 3.14159265358979 / 180) + 0.57 * Cos(2 * L * 3.14159265358979 / 180) + 0.1 * Cos(2 * ll * 3.14159265358979 / 180) - 0.09 * Cos(2 * omega * 3.14159265358979 / 180)
  NutationBreite = NutationBreite / 3600
    
End Function



Function jdjahr(jd As Double, Zeitzone As Double) As Double

'  Jahr aus JD

Dim Z As Double
Dim a As Double
Dim alpha As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim e As Double

jd = 0.5 + jd + Zeitzone / 24

Z = Fix(jd)
F = jd - Z

If Z < 2299161 Then
a = Z
End If

If Z >= 2299161 Then
alpha = Fix((Z - 1867216.25) / 36524.25)
a = Z + 1 + alpha - Fix(alpha / 4)
End If

 b = a + 1524
 c = Fix((b - 122.1) / 365.25)
 d = Fix(365.25 * c)
 e = Fix((b - d) / 30.6001)
 
 tag = b - d - Fix(30.6001 * e) + F
 
 If e < 14 Then
 e = e - 1
 End If
 
 If e = 14 Then
 e = e - 13
 End If
 
 If e = 15 Then
 e = e - 13
 End If
 
 monat = e
 
 If monat > 2 Then
 c = c - 4716
 End If
 
 If monat = 2 Then
 c = c - 4715
 End If
 
 If monat = 1 Then
 c = c - 4715
 End If
 
 jahr = c
 
 jdjahr = c
  
 
  
 
End Function


Function jdmonat(jd As Double, Zeitzone As Double) As Double

'  Monat aus JD

Dim Z As Double
Dim a As Double
Dim alpha As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim e As Double


jd = 0.5 + jd + Zeitzone / 24

Z = Fix(jd)
F = jd - Z

If Z < 2299161 Then
a = Z
End If

If Z >= 2299161 Then
alpha = Fix((Z - 1867216.25) / 36524.25)
a = Z + 1 + alpha - Fix(alpha / 4)
End If

 b = a + 1524
 c = Fix((b - 122.1) / 365.25)
 d = Fix(365.25 * c)
 e = Fix((b - d) / 30.6001)
 
 tag = b - d - Fix(30.6001 * e) + F
 
 If e < 14 Then
 e = e - 1
 End If
 
 If e = 14 Then
 e = e - 13
 End If
 
 If e = 15 Then
 e = e - 13
 End If
 
 monat = e
 
 If monat > 2 Then
 c = c - 4716
 End If
 
 If monat = 2 Then
 c = c - 4715
 End If
 
 If monat = 1 Then
 c = c - 4715
 End If
 
 jahr = c
 
 jdmonat = monat
  
  
 
End Function


Function jdtag(jd As Double, Zeitzone As Double) As Double

'  Tag aus JD

Dim Z As Double
Dim a As Double
Dim alpha As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim e As Double


jd = 0.5 + jd + Zeitzone / 24

Z = Fix(jd)
F = jd - Z

If Z < 2299161 Then
a = Z
End If

If Z >= 2299161 Then
alpha = Fix((Z - 1867216.25) / 36524.25)
a = Z + 1 + alpha - Fix(alpha / 4)
End If

 b = a + 1524
 c = Fix((b - 122.1) / 365.25)
 d = Fix(365.25 * c)
 e = Fix((b - d) / 30.6001)
 
 tag = b - d - Fix(30.6001 * e) + F
 
 If e < 14 Then
 e = e - 1
 End If
 
 If e = 14 Then
 e = e - 13
 End If
 
 If e = 15 Then
 e = e - 13
 End If
 
 monat = e
 
 If monat > 2 Then
 c = c - 4716
 End If
 
 If monat = 2 Then
 c = c - 4715
 End If
 
 If monat = 1 Then
 c = c - 4715
 End If
 
 jahr = c
 
 jdtag = Fix(tag)
  
  
 
End Function



Function jdzeit(jd As Double, Zeitzone As Double) As Double

'  Zeit aus JD

Dim Z As Double
Dim a As Double
Dim alpha As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim e As Double


jd = 0.5 + jd + Zeitzone / 24

Z = Fix(jd)
F = jd - Z

If Z < 2299161 Then
a = Z
End If

If Z >= 2299161 Then
alpha = Fix((Z - 1867216.25) / 36524.25)
a = Z + 1 + alpha - Fix(alpha / 4)
End If

 b = a + 1524
 c = Fix((b - 122.1) / 365.25)
 d = Fix(365.25 * c)
 e = Fix((b - d) / 30.6001)
 
 tag = b - d - Fix(30.6001 * e) + F
 
 If e < 14 Then
 e = e - 1
 End If
 
 If e = 14 Then
 e = e - 13
 End If
 
 If e = 15 Then
 e = e - 13
 End If
 
 monat = e
 
 If monat > 2 Then
 c = c - 4716
 End If
 
 If monat = 2 Then
 c = c - 4715
 End If
 
 If monat = 1 Then
 c = c - 4715
 End If
 
 jahr = c
 
 jdzeit = tag
  
  
 
End Function


Function ZGL(jd As Double) As Double
'
'  Zeitgleichung

    Dim t As Double
    Dim L As Double
    Dim tt As Double
    Dim e As Double
    Dim Y As Double
    Dim ekl As Double
    
    t = (jd - 2451545) / 365250
    tt = (jd - 2451545) / 36525
    L = rang(280.4664567 + 360007.6982779 * t + 0.03032028 * t * t + (t * t * t) / 49931 - (t * t * t * t) / 15299 - (t * t * t * t * t) / 1988000)
    e = 0.016708617 - 0.000042037 * tt - 0.0000001236 * tt * tt
    m = rang(357.5291 + 35999.0503 * tt - 0.0001559 * tt * tt - 0.00000048 * tt * tt * tt)
    ekl = 23.43929111 - (46.815 / 3600) * tt - (0.00059 / 3600) * tt * tt + (0.001813 / 3600) * tt * tt * tt
    Y = (Tan(ekl * 3.14159265358979 / 360)) * (Tan(ekl * 3.14159265358979 / 360))
     ZGL = Y * sin(2 * L * 3.14159265358979 / 180) - 2 * e * sin(m * 3.14159265358979 / 180) + 4 * e * Y * sin(m * 3.14159265358979 / 180) * Cos(2 * L * 3.14159265358979 / 180) - 0.5 * Y * Y * sin(4 * L * 3.14159265358979 / 180) - 1.25 * e * e * sin(2 * m * 3.14159265358979 / 180)
    ZGL = 4 * (180 * ZGL / 3.14159265358979)
    ZGL = - ZGL

End Function




Function PrzessionDEK(startepoche, epoche, dek, RA As Double)
                  
                    
tt = (startepoche - 2451545) / 36525
T = (epoche - 2451545) / 36525

T2 = T * T
T3 = T2 * T
f1 = (2306.2181 + 1.39656 * tt - 0.000139 * tt * tt) * T + (0.30188 - 0.000344 * tt) * T2 + 0.017998 * T3
f2 = (2306.2181 + 1.39656 * tt - 0.000139 * tt * tt) * T + (1.09468 + 0.000066 * tt) * T2 + 0.018203 * T3
f3 = (2004.3109 - 0.8533 * tt - 0.000217 * tt * tt) * T - (0.42665 + 0.000217 * tt) * T2 - 0.041833 * T3
f1 = f1 / 3600
f2 = f2 / 3600
f3 = f3 / 3600
A = Cos(dek * 3.14159265358979 / 180) * Sin((f1 + RA) * 3.14159265358979 / 180)
b = Cos(f3 * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180) * Cos((f1 + RA) * 3.14159265358979 / 180) - Sin(f3 * 3.14159265358979 / 180) * Sin(dek * 3.14159265358979 / 180)
c = Sin(f3 * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180) * Cos((f1 + RA) * 3.14159265358979 / 180) + Cos(f3 * 3.14159265358979 / 180) * Sin(dek * 3.14159265358979 / 180)
PrzessionDEK = arcsin(c)
End Function

Function PrzessionRA(startepoche, epoche, dek, RA)

tt = (startepoche - 2451545) / 36525
T = (epoche - 2451545) / 36525
T2 = T * T
T3 = T2 * T
f1 = (2306.2181 + 1.39656 * tt - 0.000139 * tt * tt) * T + (0.30188 - 0.000344 * tt) * T2 + 0.017998 * T3
f2 = (2306.2181 + 1.39656 * tt - 0.000139 * tt * tt) * T + (1.09468 + 0.000066 * tt) * T2 + 0.018203 * T3
f3 = (2004.3109 - 0.8533 * tt - 0.000217 * tt * tt) * T - (0.42665 + 0.000217 * tt) * T2 - 0.041833 * T3
f1 = f1 / 3600
f2 = f2 / 3600
f3 = f3 / 3600
A = Cos(dek * 3.14159265358979 / 180) * Sin((f1 + RA) * 3.14159265358979 / 180)
b = Cos(f3 * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180) * Cos((f1 + RA) * 3.14159265358979 / 180) - Sin(f3 * 3.14159265358979 / 180) * Sin(dek * 3.14159265358979 / 180)
c = Sin(f3 * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180) * Cos((f1 + RA) * 3.14159265358979 / 180) + Cos(f3 * 3.14159265358979 / 180) * Sin(dek * 3.14159265358979 / 180)
amz = Arctan2(b, A)
PrzessionRA = range(f2 + amz)
End Function
Function Arctan2(RX, RY)
If RX = 0 Then RX = 0.00001
Arctan2 = Atn(RY / RX) * 180 / 3.14159265358979
If RX < 0 Then Arctan2 = Arctan2 + 180
    b = Arctan2 / 360
    A = 360 * (b - Fix(b))
    If (A < 0) Then
        A = A + 360
        End If
Arctan2 = A
End Function
Function arccos(x)
If x > 1 Then x = 1
If x < -1 Then x = -1
If (-x * x + 1) <= 0 Then x = 0.99999
 arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
 arccos = arccos * 180 / 3.14159265358979
End Function
Function arcsin(x)
If x > 1 Then x = 1
If x < -1 Then x = -1
If (-x * x + 1) <= 0 Then x = 0.99999
    arcsin = Atn(x / Sqr(-x * x + 1))
    arcsin = arcsin * 180 / 3.14159265358979
End Function





Function WinkelformatDEK(Winkel As Double) As String

If Winkel < 0 Then
vz = "-"
End If


If Winkel >= 0 Then
vz = " "
End If

Winkel = Abs(Winkel)

gg = Fix(Winkel)
m = Winkel - gg
m = 60 * m
gm = Fix(m)
s = m - gm
s = s * 60
gs = Round(s, 2)


WinkelformatDEK = vz & gg & "" & gm & "" & gs & ""
  
  
End Function

Function WinkelformatRA(Winkel As Double) As Variant


Winkel = rang(Winkel)
Winkel = Winkel / 15



gg = Fix(Winkel)
m = Winkel - gg
m = 60 * m
gm = Fix(m)
s = m - gm
s = s * 60
gs = s

 
WinkelformatRA = TimeSerial(gg, gm, gs)
  
  
End Function


Function jddatum(jd As Double, Zeitzone As Double) As Double

'  Tag aus JD

Dim Z As Double
Dim a As Double
Dim alpha As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim e As Double


jd = 0.5 + jd + Zeitzone / 24

Z = Fix(jd)
F = jd - Z

If Z < 2299161 Then
a = Z
End If

If Z >= 2299161 Then
alpha = Fix((Z - 1867216.25) / 36524.25)
a = Z + 1 + alpha - Fix(alpha / 4)
End If

 b = a + 1524
 c = Fix((b - 122.1) / 365.25)
 d = Fix(365.25 * c)
 e = Fix((b - d) / 30.6001)
 
 tag = b - d - Fix(30.6001 * e) + F
 
 If e < 14 Then
 e = e - 1
 End If
 
 If e = 14 Then
 e = e - 13
 End If
 
 If e = 15 Then
 e = e - 13
 End If
 
 monat = e
 
 If monat > 2 Then
 c = c - 4716
 End If
 
 If monat = 2 Then
 c = c - 4715
 End If
 
 If monat = 1 Then
 c = c - 4715
 End If
 
 jahr = c
 
 tag = Fix(tag)
 
 jddatum = DateSerial(jahr, monat, tag)
  
  
 
End Function



Public Function ostern(Jahreszahl As Integer) As Date

Dim k As Integer, m As Integer, s As Integer, a As Integer, d As Integer

Dim tag As Integer, monat As Integer

k = Jahreszahl \ 100
m = 15 + ((3 * k + 3) \ 4) - ((8 * k + 13) \ 25)
s = 2 - ((3 * k + 3) \ 4)
a = Jahreszahl Mod 19
d = (19 * a + m) Mod 30
r = (d \ 29) + ((d \ 28) - (d \ 29)) * (a \ 11)
og = 21 + d - r
sz = 7 - ((Jahreszahl + (Jahreszahl \ 4) + s) Mod 7)
oe = 7 - ((og - sz) Mod 7)
os = og + oe
If os > 31 Then
tag = os - 31
monat = 4
Else
tag = os
monat = 3
End If

ostern = DateSerial(Jahreszahl, monat, tag)

End Function



Function winkelsub(a As Double, b As Double) As Double
  
w = a - b
If w < 0 Then
w = 360 + w
End If

winkelsub = w

End Function



Function zgl2(Z As Double) As String
  
  Dim vz As Double
  
  F = Z
  vz = 1
  
  If Z < 0 Then
  vz = -1
  End If
  
  Z = Fix(Z)
  
  zf = (F - Z) * 60
  
  zf = Abs(Round(zf, 0))
  
zgl2 = "- " & Z & "min " & zf & "sec"

Z = Abs(Z)

zgl2 = Z & "min " & zf & "sec"

If vz < 0 Then
zgl2 = "- " & Z & "min " & zf & "sec"
End If



End Function



Function Extinktion(hhe As Double, Magnitude As Double) As Double
  
  dm = 0.2 / Cos((90 - hhe) * 3.14159265358979 / 180)
  If hhe > 85 Then
  dm = 0
  End If
   
Extinktion = Magnitude - dm

End Function


Function HhenparallaxeMond(Abstand As Double, GeozentrHhe As Double, GeogrBreite As Double) As Double




Dim p As Double
     
 
 
   p = 0.9983271 + 0.0016764 * Cos(2 * GeogrBreite * 3.14159265358979 / 180) - 0.0000035 * Cos(4 * GeogrBreite * 3.14159265358979 / 180)
   
   arg = p * (6378.14 / Abstand) * Cos(GeogrBreite * 3.14159265358979 / 180)
   HhenparallaxeMond = GeozentrHhe - Application.Asin(arg) * 180 / 3.14159265358979
    
    

    
End Function




Function ekliplamda(RA As Double, dek As Double, eklip As Double) As Double


a = RA
e = eklip
d = dek
 
sina = sin(a * 3.14159265358979 / 180)
cose = Cos(e * 3.14159265358979 / 180)
tand = Tan(d * 3.14159265358979 / 180)
sine = sin(e * 3.14159265358979 / 180)
cosa = Cos(a * 3.14159265358979 / 180)
sind = sin(d * 3.14159265358979 / 180)
cosd = Cos(d * 3.14159265358979 / 180)

sinbeta = sind * cose - cosd * sine * sina

x = (sina * cose + tand * sine)
Y = cosa

lamda = Application.Atan2(Y, x) * 180 / 3.14159265358979

beta = Application.Asin(sinbeta) * 180 / 3.14159265358979

If lamda < 0 Then
lamda = lamda + 360
End If

ekliplamda = lamda

 
End Function


Function eklipbeta(RA As Double, dek As Double, eklip As Double) As Double


a = RA
e = eklip
d = dek
 
sina = sin(a * 3.14159265358979 / 180)
cose = Cos(e * 3.14159265358979 / 180)
tand = Tan(d * 3.14159265358979 / 180)
sine = sin(e * 3.14159265358979 / 180)
cosa = Cos(a * 3.14159265358979 / 180)
sind = sin(d * 3.14159265358979 / 180)
cosd = Cos(d * 3.14159265358979 / 180)

sinbeta = sind * cose - cosd * sine * sina

x = (sina * cose + tand * sine)
Y = cosa

lamda = Application.Atan2(Y, x) * 180 / 3.14159265358979

beta = Application.Asin(sinbeta) * 180 / 3.14159265358979

If lamda < 0 Then
lamda = lamda + 360
End If

eklipbeta = beta
 
End Function




Function EklipRektaszension(lamda As Double, beta As Double, eklip As Double) As Double


L = lamda
e = eklip
b = beta

sinl = sin(L * 3.14159265358979 / 180)
cose = Cos(e * 3.14159265358979 / 180)
tanb = Tan(b * 3.14159265358979 / 180)
sine = sin(e * 3.14159265358979 / 180)
cosl = Cos(L * 3.14159265358979 / 180)
sinb = sin(b * 3.14159265358979 / 180)
cosb = Cos(b * 3.14159265358979 / 180)

sindek = sinb * cose + cosb * sine * sinl


x = (sinl * cose - tanb * sine)
Y = cosl

RA = Application.Atan2(Y, x) * 180 / 3.14159265358979

de = Application.Asin(sindek) * 180 / 3.14159265358979

If RA < 0 Then
RA = RA + 360
End If

EklipRektaszension = RA

End Function


Function EklipDeklination(lamda As Double, beta As Double, eklip As Double) As Double


L = lamda
e = eklip
b = beta

sinl = sin(L * 3.14159265358979 / 180)
cose = Cos(e * 3.14159265358979 / 180)
tanb = Tan(b * 3.14159265358979 / 180)
sine = sin(e * 3.14159265358979 / 180)
cosl = Cos(L * 3.14159265358979 / 180)
sinb = sin(b * 3.14159265358979 / 180)
cosb = Cos(b * 3.14159265358979 / 180)

sindek = sinb * cose + cosb * sine * sinl


x = (sinl * cose - tanb * sine)
Y = cosl

RA = Application.Atan2(Y, x) * 180 / 3.14159265358979

de = Application.Asin(sindek) * 180 / 3.14159265358979

If RA < 0 Then
RA = RA + 360
End If

EklipDeklination = de

End Function










Function HoriDeklination(azimut As Double, hhe As Double, Breite As Double, lokSternzeit As Double) As Double

Dim a As Double

a = rang(180 + azimut)
h = hhe
b = Breite

sina = sin(a * 3.14159265358979 / 180)
cosa = Cos(a * 3.14159265358979 / 180)
th = Tan(h * 3.14159265358979 / 180)
sinb = sin(b * 3.14159265358979 / 180)
cosb = Cos(b * 3.14159265358979 / 180)
sh = sin(h * 3.14159265358979 / 180)
ch = Cos(h * 3.14159265358979 / 180)

sindek = sinb * sh - cosb * ch * cosa



hdek = Application.Asin(sindek) * 180 / 3.14159265358979


HoriDeklination = hdek


End Function




Function HoriRektaszension(azimut As Double, hhe As Double, Breite As Double, lokSternzeit As Double) As Double

Dim a As Double

a = rang(180 + azimut)
h = hhe
b = Breite

sina = sin(a * 3.14159265358979 / 180)
cosa = Cos(a * 3.14159265358979 / 180)
th = Tan(h * 3.14159265358979 / 180)
sinb = sin(b * 3.14159265358979 / 180)
cosb = Cos(b * 3.14159265358979 / 180)
sh = sin(h * 3.14159265358979 / 180)
ch = Cos(h * 3.14159265358979 / 180)


x = sina
Y = cosa * sinb + th * cosb
StwH = Application.Atan2(Y, x) * 180 / 3.14159265358979

If StwH < 0 Then
StwH = StwH + 360
End If


hra = rang(lokSternzeit - StwH)

 HoriRektaszension = hra / (15 * 24)

End Function




Function zirkumpolar(Deklination As Double, Breite As Double) As String

Dim zp As String

d = Deklination
b = Breite

abe = d * b
abz = Abs(d + b)

bbe = abe
bbz = Abs(b - d)

zp = "normal"

If abe > 0 And abz > 90 Then
zp = "zirkumpolar"
End If

If bbe < 0 And bbz > 90 Then
zp = "unter Horizont"
End If

zirkumpolar = zp


End Function



Function Aufgang(Rektaszension As Double, Deklination As Double, SternzeitGWN As Double, Lnge As Double, Breite As Double, Zeitzone As Double, Refraktion As Double) As Double

Dim zp As String
Dim zirkumpolar As String


RA = Rektaszension
dek = Deklination
szgwn = SternzeitGWN
L = -1 * Lnge
b = Breite
r = Refraktion
zz = Zeitzone

ha = (RA + L - szgwn) / 360

If ha < 0 Then
ha = ha + 1
End If


If ha > 1 Then
ha = ha - 1
End If

ha = ha

hc = (sin(r * 3.14159265358979 / 180) - sin(b * 3.14159265358979 / 180) * sin(dek * 3.14159265358979 / 180)) / (Cos(b * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180))

If Abs(hc) >= 1 Then
zag = "no"
GoTo 100
End If

h = Application.Acos(hc) * 180 / 3.14159265358979

HH = h / 360


tagbogen = 2 * HH / 24

utag = (ha - HH) * 24
utdg = ha * 24
utug = (ha + HH) * 24
ozag = zz + utag
ozdg = zz + utdg
ozug = zz + utug


zag = ozag
zdg = ozdg
zug = ozug

If zag < 0 Then
zag = zag + 24
End If

If zag > 24 Then
zag = zag - 24
End If


If zdg < 0 Then
zdg = zdg + 24
End If

If zdg > 24 Then
zdg = zdg - 24
End If


If zug < 0 Then
zug = zug + 24
End If

If zug > 24 Then
zug = zug - 24
End If


zag = zag / 24
zdg = zdg / 24
zug = zug / 24



100:


d = dek
b = b
deta = 0

abe = d * b
abz = Abs(d + b)

bbe = abe
bbz = Abs(b - d)

If abe > 0 And abz > 90 Then
zag = "zirkumpolar"
deta = 1
End If

If bbe < 0 And bbz > 90 Then
zag = "unter Horizont"
deta = 1
End If

zirkumpolar = zp

deta = deta




Aufgang = zag



End Function




Function Durchgang(RektaszensionA As Double, DeklinationA As Double, SternzeitGWN As Double, Lnge As Double, Breite As Double, Zeitzone As Double, Refraktion As Double)

Dim zp As String
Dim zirkumpolar As String


RA = RektaszensionA
dek = DeklinationA
szgwn = SternzeitGWN
L = -1 * Lnge
b = Breite
r = Refraktion
zz = Zeitzone

ha = (RA + L - szgwn) / 360

If ha < 0 Then
ha = ha + 1
End If


If ha > 1 Then
ha = ha - 1
End If

ha = ha

hc = (sin(r * 3.14159265358979 / 180) - sin(b * 3.14159265358979 / 180) * sin(dek * 3.14159265358979 / 180)) / (Cos(b * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180))

If Abs(hc) >= 1 Then
zdg = "no"
GoTo 100
End If

h = Application.Acos(hc) * 180 / 3.14159265358979

HH = h / 360


tagbogen = 2 * HH / 24

utag = (ha - HH) * 24
utdg = ha * 24
utug = (ha + HH) * 24
ozag = zz + utag
ozdg = zz + utdg
ozug = zz + utug


zag = ozag
zdg = ozdg
zug = ozug

If zag < 0 Then
zag = zag + 24
End If

If zag > 24 Then
zag = zag - 24
End If


If zdg < 0 Then
zdg = zdg + 24
End If

If zdg > 24 Then
zdg = zdg - 24
End If


If zug < 0 Then
zug = zug + 24
End If

If zug > 24 Then
zug = zug - 24
End If


zag = zag / 24
zdg = zdg / 24
zug = zug / 24



100:


d = dek
b = b
deta = 0

abe = d * b
abz = Abs(d + b)

bbe = abe
bbz = Abs(b - d)

If abe > 0 And abz > 90 Then
zdg = "zirkumpolar"
deta = 1
End If

If bbe < 0 And bbz > 90 Then
zdg = "unter Horizont"
deta = 1
End If

zirkumpolar = zp

deta = deta





Durchgang = zdg



End Function



Function Untergang(Rektaszension As Double, Deklination As Double, SternzeitGWN As Double, Lnge As Double, Breite As Double, Zeitzone As Double, Refraktion As Double)

Dim zp As String
Dim zirkumpolar As String


RA = Rektaszension
dek = Deklination
szgwn = SternzeitGWN
L = -1 * Lnge
b = Breite
r = Refraktion
zz = Zeitzone

ha = (RA + L - szgwn) / 360

If ha < 0 Then
ha = ha + 1
End If


If ha > 1 Then
ha = ha - 1
End If

ha = ha

hc = (sin(r * 3.14159265358979 / 180) - sin(b * 3.14159265358979 / 180) * sin(dek * 3.14159265358979 / 180)) / (Cos(b * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180))

If Abs(hc) >= 1 Then
zug = "no"
GoTo 100
End If

h = Application.Acos(hc) * 180 / 3.14159265358979

HH = h / 360


tagbogen = 2 * HH / 24

utag = (ha - HH) * 24
utdg = ha * 24
utug = (ha + HH) * 24
ozag = zz + utag
ozdg = zz + utdg
ozug = zz + utug


zag = ozag
zdg = ozdg
zug = ozug

If zag < 0 Then
zag = zag + 24
End If

If zag > 24 Then
zag = zag - 24
End If


If zdg < 0 Then
zdg = zdg + 24
End If

If zdg > 24 Then
zdg = zdg - 24
End If


If zug < 0 Then
zug = zug + 24
End If

If zug > 24 Then
zug = zug - 24
End If


zag = zag / 24
zdg = zdg / 24
zug = zug / 24



100:


d = dek
b = b
deta = 0

abe = d * b
abz = Abs(d + b)

bbe = abe
bbz = Abs(b - d)

If abe > 0 And abz > 90 Then
zug = "zirkumpolar"
deta = 1
End If

If bbe < 0 And bbz > 90 Then
zug = "unter Horizont"
deta = 1
End If

zirkumpolar = zp

deta = deta


Untergang = zug


End Function





Function jdUT(jahr As Integer, monat As Integer, tag As Integer) As Double


     
   Dim d As Double
   Dim a As Double
   Dim b As Double
   Dim jd As Double
    
    If monat > 2 Then
    monat = monat
    jahr = jahr
    End If
    
    If monat <= 2 Then
    monat = monat + 12
    jahr = jahr - 1
    End If
    
    a = Fix(jahr / 100)
    b = 2 - a + Fix(a / 4)
    
    jdUT = Fix(365.25 * (jahr + 4716)) + Fix(30.6001 * (monat + 1)) + tag + b - 1524.5
    
       

End Function


Function Interpolation3(a1 As Double, a2 As Double, a3 As Double, n As Double) As Double

a = a2 - a1
b = a3 - a2
c = a1 + a3 - 2 * a2

Interpolation3 = a2 + (n / 2) * (a + b + n * c)
 
End Function


Function nm(RektaszensionA As Double, SternzeitGWN As Double, Lnge As Double) As Double


RA = RektaszensionA
szgwn = SternzeitGWN
L = -1 * Lnge



nm = (RA + L - szgwn) / 360

If nm < 0 Then
nm = nm + 1
End If


If nm > 1 Then
nm = nm - 1
End If

nm = nm

End Function



Function ParabelNullstelle(ym As Double, yz As Double, yp As Double)

        
    a = 0.5 * (ym + yp) - yz
    b = 0.5 * (yp - ym)
    c = yz
    
    dis = b * b - 4 * a * c
    Z = "no"
    If (dis > 0) Then
     z1 = (-1 * b + Sqr(dis)) / (2 * a)
     z2 = (-1 * b - Sqr(dis)) / (2 * a)
   End If
   
   If Abs(z1) <= 1 Then
   Z = z1
   End If
   
   If Abs(z2) <= 1 Then
   Z = z2
   End If
   
   ParabelNullstelle = Z
   
   
   End Function
   
   
   Function Parabelmax(ym As Double, yz As Double, yp As Double)

        
    a = 0.5 * (ym + yp) - yz
    b = 0.5 * (yp - ym)
    c = yz
    
    xm = -1 * b / (2 * a)
    
  Parabelmax = xm
   
   
   End Function
   
   Function DurchgangSonne(jahr As Double, monat As Double, tag As Double, Lnge As Double, Zeitzone As Double) As Double


     
   Dim d As Double
   Dim a As Double
   Dim b As Double
   Dim zd As Double
    
    If monat > 2 Then
    monat = monat
    jahr = jahr
    End If
    
    If monat <= 2 Then
    monat = monat + 12
    jahr = jahr - 1
    End If
    
    a = Fix(jahr / 100)
    b = 2 - a + Fix(a / 4)
    
    zd = Fix(365.25 * (jahr + 4716)) + Fix(30.6001 * (monat + 1)) + tag + b - 1524.5 + 0.5
    
       
       
  
  
 DurchgangSonne = (12 + ZGL(zd) / 60) / 24 + (Zeitzone / 24) - (Lnge * 4) / (60 * 24)
 
 If DurchgangSonne > 1 Then
 DurchgangSonne = DurchgangSonne - 1
 End If
 
 If DurchgangSonne < 0 Then
 DurchgangSonne = DurchgangSonne + 1
 End If
 
DurchgangSonne = DurchgangSonne
 
End Function
   
   
   
Function KW(d As Date) As Integer
    t = DateSerial(year(d + (8 - Weekday(d)) Mod 7 - 3), 1, 1)
    KW = (d - t - 3 + (Weekday(t) + 1) Mod 7) \ 7 + 1
End Function


Function Schaltjahr(Jahreszahl)
   If (Jahreszahl Mod 4) = 0 And (Jahreszahl Mod 100) <> 0 Or _
     ((Jahreszahl Mod 400) = 0) Then
      Schaltjahr = "Schaltjahr"
   Else
      Schaltjahr = "kein Schaltjahr"
   End If

Schaltjahr = Schaltjahr
End Function


Function Sommerzeit(Jahreszahl As Integer) As Date
Dim ti As Integer
Dim dzu As Integer


For ti = 31 To 25 Step -1

 szu = DateSerial(Jahreszahl, 3, ti)
 dzu = Weekday(szu)
 
 If dzu = 1 Then GoTo 100
 
 Next
 
100:
 
Sommerzeit = szu

  
  
End Function



Function Winterzeit(Jahreszahl As Integer) As Date
Dim ti As Integer
Dim dzu As Integer


For ti = 31 To 25 Step -1

 szu = DateSerial(Jahreszahl, 10, ti)
 dzu = Weekday(szu)
 
 If dzu = 1 Then GoTo 100
 
 Next
 
100:
 
Winterzeit = szu

  
  
End Function

  
Function quaParallaxeMond(Abstand As Double) As Double
              
  quaParallaxeMond = Application.Asin(6378.14 / Abstand) * 180 / 3.14159265358979
 
End Function

Function quaParallaxePlanet(Abstand As Double) As Double
              
  quaParallaxePlanet = Application.Asin((8.794 / 3600) / Abstand) * 180 / 3.14159265358979
 
End Function



Function GeozDeklination(geoBreite As Double) As Double


gb = (692.73 / 3600) * sin(2 * geoBreite * 3.14159265358979 / 180) - (1.16 / 3600) * sin(4 * geoBreite * 3.14159265358979 / 180)
              
GeozDeklination = geoBreite - gb
 
End Function


Function GeogrBreite(dek As Double) As Double

            
  GeogrBreite = dek + 0.1924 * sin(2 * dek * 3.14159265358979 / 180)
 
End Function



Function TopoDek(Parallaxe As Double, geozStdw As Double, GeogrBreite As Double, HStandort As Double, dek As Double) As Double

Dim u As Double
Dim pcb As Double
Dim psb As Double
Dim drax As Double
Dim dray As Double


pp = Parallaxe
h = geozStdw
b = GeogrBreite
dek = dek
hs = HStandort

u = 0.99664719 * Tan(b * 3.14159265358979 / 180)

u = Application.Atan2(1, u) * 180 / 3.14159265358979


pcb = Cos(u * 3.14159265358979 / 180) + (hs / 6378140) * Cos(b * 3.14159265358979 / 180)
psb = 0.99664719 * sin(u * 3.14159265358979 / 180) + (hs / 6378140) * sin(b * 3.14159265358979 / 180)


drax = -1 * pcb * sin(pp * 3.14159265358979 / 180) * sin(h * 3.14159265358979 / 180)
dray = Cos(dek * 3.14159265358979 / 180) - pcb * sin(pp * 3.14159265358979 / 180) * Cos(h * 3.14159265358979 / 180)

dra = Application.Atan2(dray, drax) * 180 / 3.14159265358979
            
  xdek = (sin(dek * 3.14159265358979 / 180) - psb * sin(pp * 3.14159265358979 / 180)) * Cos(dra * 3.14159265358979 / 180)
  ydek = Cos(dek * 3.14159265358979 / 180) - pcb * sin(pp * 3.14159265358979 / 180) * Cos(h * 3.14159265358979 / 180)
 
 
 

TopoDek = Application.Atan2(ydek, xdek) * 180 / 3.14159265358979

 
End Function


Function TopoRA(Parallaxe As Double, geozStdw As Double, GeogrBreite As Double, HStandort As Double, dek As Double, RA As Double) As Double

Dim u As Double
Dim pcb As Double
Dim psb As Double
Dim drax As Double
Dim dray As Double


pp = Parallaxe
h = geozStdw
b = GeogrBreite
dek = dek
hs = HStandort

u = 0.99664719 * Tan(b * 3.14159265358979 / 180)

u = Application.Atan2(1, u) * 180 / 3.14159265358979


pcb = Cos(u * 3.14159265358979 / 180) + (hs / 6378140) * Cos(b * 3.14159265358979 / 180)
psb = 0.99664719 * sin(u * 3.14159265358979 / 180) + (hs / 6378140) * sin(b * 3.14159265358979 / 180)


drax = -1 * pcb * sin(pp * 3.14159265358979 / 180) * sin(h * 3.14159265358979 / 180)
dray = Cos(dek * 3.14159265358979 / 180) - pcb * sin(pp * 3.14159265358979 / 180) * Cos(h * 3.14159265358979 / 180)

dra = Application.Atan2(dray, drax) * 180 / 3.14159265358979
            
  
 
 
 

TopoRA = dra + RA

TopoRA = rang(TopoRA)

 
End Function


Public Function deksonne(jd As Double)


   Dim longitude_soleil As Double
Dim longitude_vraie_soleil As Double
Dim longitude_apparente_soleil As Double
Dim anomalie_soleil As Double
Dim anomalie_vraie_soleil As Double
Dim excentricite_orbite_terre As Double
Dim centre_soleil As Double
Dim obliquite_ecliptique As Double
Dim declinaison_soleil As Double
Dim ascension_soleil As Double
     
    t = jd

     sjulien = (t - 2451545) / 36525
     
     
    
     
   jd1 = t * 36525 + 2451545
   
   es = (jd1 - 2415020) / 36525



a1 = 153.23 + 22518.7541 * es
a2 = 216.57 + 45037.5082 * es
a3 = 312.69 + 32964.3577 * es
a4 = 350.74 + 445267.1142 * es - 0.00144 * es * es
a5 = 231.19 + 20.2 * es

b1 = 0.00134 * Cos(a1 * 3.14159265358979 / 180)
b2 = 0.00154 * Cos(a2 * 3.14159265358979 / 180)
b3 = 0.002 * Cos(a3 * 3.14159265358979 / 180)
b4 = 0.00179 * sin(a4 * 3.14159265358979 / 180)
b5 = 0.00178 * sin(a5 * 3.14159265358979 / 180)

bges = b1 + b2 + b3 + b4 + b5
     
     
     

    longitude_soleil = 280.46645 + (36000.76983 * sjulien) + (0.0003032 * sjulien ^ 2)
    longitude_soleil = range(longitude_soleil)

    anomalie_soleil = 357.5291 + (35999.0503 * sjulien) - (0.0001559 * sjulien ^ 2) - (0.00000048 * sjulien ^ 3)
    anomalie_soleil = range(anomalie_soleil)

    excentricite_orbite_terre = 0.01670817 - (0.000042037 * sjulien) - (0.0000001236 * sjulien ^ 2)
                       
    centre_soleil = ((1.9146 - (0.004817 * sjulien) - _
                    (0.000014 * sjulien ^ 2)) * sin((3.1415926535 / 180) * (anomalie_soleil))) + _
                    ((0.019993 - (0.000101 * sjulien)) * sin((3.1415926535 / 180) * (2 * anomalie_soleil))) + _
                    (0.00029 * sin((3.1415926535 / 180) * (3 * anomalie_soleil)))
    
    centre_soleil = range(centre_soleil)

        anomalie_vraie_soleil = anomalie_soleil + centre_soleil
    
    anomalie_vraie_soleil = range(anomalie_vraie_soleil)

        longitude_vraie_soleil = longitude_soleil + centre_soleil
    
    longitude_vraie_soleil = range(longitude_vraie_soleil)

        longitude_apparente_soleil = longitude_vraie_soleil - 0.00569 - _
                    0.00478 * sin((3.1415926535 / 180) * (125.04 - (1934.136 * sjulien))) + bges
    
    longitude_apparente_soleil = range(longitude_apparente_soleil)

        obliquite_ecliptique = 23.43929111 - (0.01300417 * sjulien) - (0.000001639 * sjulien ^ 2) + _
                    (0.0000005036 * sjulien ^ 3)
    
    obliquite_ecliptique = range(obliquite_ecliptique)

        ascension_soleilx = Cos((3.1415926535 / 180) * obliquite_ecliptique) * sin((3.1415926535 / 180) * longitude_vraie_soleil)
                      
        ascension_soleilY = Cos((3.1415926535 / 180) * longitude_vraie_soleil)
                  
                                  
                          
     
  
  decx = sin((3.1415926535 / 180) * obliquite_ecliptique) * sin((3.1415926535 / 180) * (longitude_vraie_soleil))
  
  dec = Atn(decx / Sqr(1 - decx * decx)) * 180 / 3.14159265358979


    
ascension_soleil = Atn(ascension_soleilx / ascension_soleilY) * 180 / 3.14159265358979

If ascension_soleilY < 0 Then
   ascension_soleil = 180 + ascension_soleil
End If
     
RA = range(ascension_soleil)


deksonne = dec

End Function

Public Function rasonne(jd As Double)


   Dim longitude_soleil As Double
Dim longitude_vraie_soleil As Double
Dim longitude_apparente_soleil As Double
Dim anomalie_soleil As Double
Dim anomalie_vraie_soleil As Double
Dim excentricite_orbite_terre As Double
Dim centre_soleil As Double
Dim obliquite_ecliptique As Double
Dim declinaison_soleil As Double
Dim ascension_soleil As Double
     
t = jd    

     sjulien = (t - 2451545) / 36525
     
     
    
     
   jd1 = t * 36525 + 2451545
   
   es = (jd1 - 2415020) / 36525



a1 = 153.23 + 22518.7541 * es
a2 = 216.57 + 45037.5082 * es
a3 = 312.69 + 32964.3577 * es
a4 = 350.74 + 445267.1142 * es - 0.00144 * es * es
a5 = 231.19 + 20.2 * es

b1 = 0.00134 * Cos(a1 * 3.14159265358979 / 180)
b2 = 0.00154 * Cos(a2 * 3.14159265358979 / 180)
b3 = 0.002 * Cos(a3 * 3.14159265358979 / 180)
b4 = 0.00179 * sin(a4 * 3.14159265358979 / 180)
b5 = 0.00178 * sin(a5 * 3.14159265358979 / 180)

bges = b1 + b2 + b3 + b4 + b5

     
     

    longitude_soleil = 280.46645 + (36000.76983 * sjulien) + (0.0003032 * sjulien ^ 2)
    longitude_soleil = range(longitude_soleil)

    anomalie_soleil = 357.5291 + (35999.0503 * sjulien) - (0.0001559 * sjulien ^ 2) - (0.00000048 * sjulien ^ 3)
    anomalie_soleil = range(anomalie_soleil)

    excentricite_orbite_terre = 0.01670817 - (0.000042037 * sjulien) - (0.0000001236 * sjulien ^ 2)
                       
    centre_soleil = ((1.9146 - (0.004817 * sjulien) - _
                    (0.000014 * sjulien ^ 2)) * sin((3.1415926535 / 180) * (anomalie_soleil))) + _
                    ((0.019993 - (0.000101 * sjulien)) * sin((3.1415926535 / 180) * (2 * anomalie_soleil))) + _
                    (0.00029 * sin((3.1415926535 / 180) * (3 * anomalie_soleil)))
    
    centre_soleil = range(centre_soleil)

        anomalie_vraie_soleil = anomalie_soleil + centre_soleil
    
    anomalie_vraie_soleil = range(anomalie_vraie_soleil)

        longitude_vraie_soleil = longitude_soleil + centre_soleil
    
    longitude_vraie_soleil = range(longitude_vraie_soleil)

        longitude_apparente_soleil = longitude_vraie_soleil - 0.00569 - _
                    0.00478 * sin((3.1415926535 / 180) * (125.04 - (1934.136 * sjulien))) + bges
    
    longitude_apparente_soleil = range(longitude_apparente_soleil)

        obliquite_ecliptique = 23.43929111 - (0.01300417 * sjulien) - (0.000001639 * sjulien ^ 2) + _
                    (0.0000005036 * sjulien ^ 3)
    
    obliquite_ecliptique = range(obliquite_ecliptique)

        ascension_soleilx = Cos((3.1415926535 / 180) * obliquite_ecliptique) * sin((3.1415926535 / 180) * longitude_vraie_soleil)
                      
        ascension_soleilY = Cos((3.1415926535 / 180) * longitude_vraie_soleil)
                  
                                  
                          
     
  
  decx = sin((3.1415926535 / 180) * obliquite_ecliptique) * sin((3.1415926535 / 180) * (longitude_vraie_soleil))
  
  dec = Atn(decx / Sqr(1 - decx * decx)) * 180 / 3.14159265358979


    
ascension_soleil = Atn(ascension_soleilx / ascension_soleilY) * 180 / 3.14159265358979

If ascension_soleilY < 0 Then
   ascension_soleil = 180 + ascension_soleil
End If
     
RA = range(ascension_soleil)

rasonne = RA



End Function



Function moz(t As Date, L As Double, zeitgl As Double, zeitzo As Double)


L = -1 * L
L = (L / 15) / 24

   
    stunde = hour(t)
    min = Minute(t)
    sec = Second(t)

utl = stunde + min / 60 + sec / 3600
utl = (utl / 24) - zeitzo / 24

moz = utl - L


If moz > 1 Then
moz = moz - 1

End If

If moz < 0 Then
moz = moz + 1

End If

moz = moz


End Function
Function woz(zeitgl As Double, zeitmoz As Double) As Date

woz = zeitmoz - zeitgl / (24 * 60)

If woz > 1 Then
woz = woz - 1

End If

If woz < 0 Then
woz = woz + 1

End If

woz = woz

End Function




Function GeogrLnge(RA As Double, GMST As Double) As Double


       
  GeogrLnge = rang(RA - GMST)
  

End Function


Function rsonne(jd As Double) As Double

t = (jd - 2451545) / 36525
e = 0.016708617 - 0.000042037 * t - 0.0000001236 * t * t
m = 357.5291 + (35999.0503 * t) - (0.0001559 * t ^ 2) - (0.00000048 * t ^ 3)
c = ((1.9146 - (0.004817 * t) - _
                    (0.000014 * t ^ 2)) * Sin((3.1415926535 / 180) * (m))) + _
                    ((0.019993 - (0.000101 * t)) * Sin((3.1415926535 / 180) * (2 * m))) + _
                    (0.00029 * Sin((3.1415926535 / 180) * (3 * m)))
                    
 rsonne = 1.000001018 * (1 - e * e) / (1 + e * Cos((3.1415926535 / 180) * (c + m)))



End Function

